home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacHack 1994
/
MacHack 1994.toast
/
MacHack™94
/
Talks & Papers
/
Timothy Knox
/
Pocket6.3
/
Extensions
/
Apple Events
/
AppleEvents
< prev
next >
Wrap
Text File
|
1994-06-24
|
7KB
|
158 lines
( Apple Events for Pocket Forth )
\ Be sure that you are running this file on a COPY of
\ the Pocket Forth application [not the DA]. Close the
\ window if you need to quit and make a back up copy.
\ If this is a backup, press return to continue.
key drop
page forget task decimal 0 28 +md !
\ Define Apple Event handlers by using ae: and ;ae. Start the
\ definition by putting an event type and class on the stack and
\ calling ae: . Follow with code comprising the handler, then
\ end the handler with ;ae .
( get AEDesc handle from an Apple Event )
: ?DESC ( d.key d.type -- desc.handle desc.type -1 or 0 )
0 >r ( room for error )
202 +md 2@ 2>r ( the AppleEvent handle )
2swap 2>r 2>r ( keyword and type )
here a>r ( recieving address )
,$ 303C ,$ 812 ,$ A816 ( AEGetParamDesc: move #$812,d0 _Pack8 )
r> 0= IF ( if there is no error )
here 4 + 2@ here 2@ -1 ( get data & leave true )
ELSE 0 THEN ; ( or else leave false )
: -DESC ( addr.where.desc.is.stored -- error ) ( remove desc rec. )
0 >r a>r ( push room and descriptor )
,$ 303C ,$ 0204 ,$ A816 ( AEDisposeDesc: move #$0204,d0 _Pack8 )
r> ;
\ Reply to an Apple Event with a string
: REPLY ( addr count -- ) \ **** USE INSIDE OF A HANDLER ONLY ****
0 >r \ put room for error on rstack
198 +md 2@ 2>r \ put the ReplyEvent handle on rstack
,s ---- 2>r ,s TEXT 2>r \ put keyword and type on rstack
swap a>r 0 2>r \ put addr & count on rs from pstack
,$ 303C ,$ 0A0F ,$ A816 \ AEPutParamPtr: move #$A0F,d0 _Pack8
r> drop ; \ ignore any error
( Do Script Apple Event: misc dosc )
( Run a 80 character line of text as Pocket Forth code. )
( This word is installed into the idle handler by the dosc event. )
( In order to exit into the interpreter the main part of the code )
( is run outside of the “ae: ... ;ae” pair )
2variable DDATA 4 allot ( d.type d.handle )
variable OIDLE 20 +md @ oidle ! ( hold the old idle routine addr )
: DIDLE ( -- ) ( interpret text whose handle is at above variable )
oidle @ 20 +md ! ( first reset idle routine to null )
( movea.l dd+4[bp],a0 ) ,$ 206B [ ddata 4 + , ] \ theHandle
( _GetHandleSize ) ,$ A025 \ bytes to move in d0
( movea.l [a0],a0 ) ,$ 2050 \ source address in a0
( movea.l a4,a1 ) ,$ 224C \ tib is destination in a1
78 [ ' min 2+ compile ] drop \ 78 bytes max in d0
( _BlockMove ) ,$ A02E \ move data to input stream
ddata -desc \ dispose of descriptor
0= IF \ if there is no error
13 tib 80 + c! \ put cr at of end of i.s.
interpret \ jump to interpreter
THEN ;
\ The apple event handler for the 'dosc' (do script) event.
,s dosc ,s misc ae: ( d.eventType d.eventClass -- )
,s ---- ,s TEXT ?desc IF \ get handle to data
ddata 2! ddata 4 + 2! \ store descriptor record
20 +md @ oidle ! \ hold idle routine
[ ' dIdle literal ] 20 +md ! \ set idle routine to dIdle
\ it will execute on the next
THEN ;ae \ trip through the event loop
( Paste Apple Event: misc past )
( Like the dosc event, the past event installs part of its handler)
( into the idle routine, run the next time through the event loop.)
( temporary idle routine for the Paste handler )
: PIDLE ( -- ) ( run the Paste menu handler )
oidle @ 20 +md ! ( reset idle routine to origonal )
[ 18 +md @ ( -- menus variable: address of menu list )
2+ @ ( -- Edit menu )
8 + @ ( -- Paste handler )
compile ] ( compile Paste handler routine for idle )
interpret [ ( jump to interpreter )
( Paste Apple Event handler )
,s past ,s misc ae:
20 +md @ oidle ! ( hold on to origonal idle )
[ ' pIdle literal ] 20 +md ! ( set idle routine to above )
;ae
\ Message is a defining word for setting up strings for REPLYing
: MESSAGE" \ compiling: ( -- ) enclose subsequent quoted string
CREATE 34 word here c@ 1+ dup 2 mod + allot
DOES> count ; \ runtime action: ( -- addr count )
message" SERROR Empty stack."
message" UERROR Unknown type."
\ represent numbers as strings
: D$ ( d -- addr count ) \ convert double number to string
depth 1 > IF swap over dabs <# #s sign #>
ELSE serror THEN ;
: F$ ( f -- addr count )
depth 4 > IF
@pen 2>r 10 +md @ >r 30000 10 +md ! \ move pen offscreen
3000 3000 !pen f. \ print float: string is at here
r> 10 +md ! 2r> !pen \ return pen to origonal position
here count
ELSE serror THEN ;
: I$ ( n -- addr count ) depth IF s>d d$ ELSE serror THEN ;
: S$ ( addr -- addr+1 count ) depth IF count ELSE serror THEN ;
variable DTYPE 4 allot 4 dtype ! \ length is allways 4
: ?DTYPE ( d -- flag ) \ true if d = dtype+2
dtype 2+ 2@ dnegate d+ + 0= ;
\ Evaluate Apple Event: ( misc,eval )
\ From HyperCard: request 'float' of program 'Pocket Forth'
\ Or from Frontier: pf.request("float")
\ misc,eval takes data from the stack and returns it in various
\ forms depending on the ---- parameter.
\ FLOA = floating point number
\ SHOR = 16 bit integer
\ LONG = 32 bit integer
\ STRI = pascal type string
( The apple event handler for the 'eval' event. )
,s eval ,s misc ae:
,s ---- ,s TEXT ?desc IF \ if there is no error
2drop dtype 2+ a>r \ hold addr on rstack
,$ 7004 ( moveq.l #4,d0 ) \ bytes to move in d0
,$ 205E ( movea.l [ps]+,a0 ) \ handle in a0
,$ 2050 ( movea.l [a0],a0 ) \ source address in a0
,$ 225F ( movea.l [sp]+,a1 ) \ destination in a1
,$ A02E ( _BlockMove ) \ move data to here
dtype 1+ upper \ move it to dtype
,s SHOR ?dtype IF i$ ELSE \ short requested
,s LONG ?dtype IF d$ ELSE \ long requested
,s FLOA ?dtype IF f$ ELSE \ float requested
,s STRI ?dtype IF s$ ELSE \ string requested
uerror \ other request
THEN THEN THEN THEN reply THEN ;ae
: task ; ( protect this from "forget task" )
-1 28 +md ! save bye